home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / epistat.arc / CORRELAT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-18  |  2.9 KB  |  57 lines
  1. 1  REM             PEARSON'S CORRELATION COEFFICIENT
  2. 2  REM             Written by Tracy L. Gustafson, M.D.
  3. 3  REM            Round Rock, Texas. Version 2.0, 1983
  4. 5  DEF SEG=&H40
  5. 6  A=PEEK(&H17): IF NOT(A AND &H20) THEN POKE &H17,(A AND (NOT &H20)) OR &H20
  6. 7  DEF SEG: KEY OFF: SCREEN 0,0: WIDTH 80: COLOR 7,0,1
  7. 10  CLEAR: OPTION BASE 1: DEFINT A-C,N,T,Z: DEFSTR D
  8. 20  CLS: PRINT TAB(18);"KEY";STRING$(35,205);"CLOSE"
  9. 22  PRINT TAB(18);"OPEN PEARSON'S CORRELATION COEFFICIENT OPEN"
  10. 25  PRINT TAB(18);"SCREEN";STRING$(35,205);"LOAD"
  11. 30  PRINT: AP=CSRLIN: PRINT TAB(10);"What is the name of the DATAFILE you wish to analyze?": ON ERROR GOTO 430
  12. 40  PRINT TAB(3);"(Enter RETURN if you wish to evaluate significance of a known R value)"
  13. 50  LOCATE AP,65: INPUT "",FILE$
  14. 60  IF FILE$<>"" THEN 90 ELSE AF=1
  15. 70  PRINT: PRINT: PRINT TAB(10);: INPUT;"Enter R value:  ",SR: SR2=SR*SR
  16. 75  IF SR>=1 THEN BEEP: PRINT "  Your correlation coefficient should be a decimal fraction between 0 and 1.": GOTO 70
  17. 80  PRINT TAB(39);:INPUT "Number of data pairs:  ",N: GOTO 240
  18. 90  AF=0: OPEN FILE$ FOR INPUT AS #1: INPUT #1,A,C
  19. 100  DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),T(A),SD(A),MD(A)
  20. 110  FOR T=1 TO A: INPUT #1, T(T): NEXT
  21. 120  FOR T=1 TO A: FOR Z=1 TO C: INPUT #1, D(T,Z): NEXT: NEXT
  22. 130  FOR T=1 TO A: FOR Z=1 TO T(T): INPUT #1, CS(T,Z): NEXT: NEXT
  23. 140  FOR T=1 TO A: INPUT #1, N$(T),X(T),X2(T),MD(T),SD(T): NEXT: CLOSE #1
  24. 150  PRINT: PRINT: PRINT TAB(5);"What are the SAMPLE NUMBERS of the 2 groups you want to correlate?": PRINT
  25. 160  PRINT TAB(12);:INPUT;"Number:  ",NS1: IF NS1<=A THEN PRINT "  `";N$(NS1);"'"; ELSE BEEP: PRINT TAB(21);FILE$;" has only";A;"samples.": GOTO 160
  26. 165  PRINT TAB(45);:INPUT;"Number:  ",NS2: IF NS2<=A THEN PRINT "  `";N$(NS2);"'" ELSE BEEP: PRINT TAB(21);FILE$;" has only";A;"samples.": GOTO 165
  27. 170  IF T(NS1)<> T(NS2) THEN PRINT : PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(32);"a correlation coefficient cannot be calculated.": GOTO 150
  28. 180  XC=0: N=T(NS1)
  29. 190  FOR Z=1 TO N: XC=XC+VAL(D(NS1,Z))*VAL(D(NS2,Z)): NEXT
  30. 200  SC=XC-X(NS1)*X(NS2)/N
  31. 210  SX=X2(NS1)-X(NS1)*X(NS1)/N: SY=X2(NS2)-X(NS2)*X(NS2)/N
  32. 220  SR2=SC*SC/(SX*SY)
  33. 230  PRINT: PRINT TAB(20);"Correlation coefficient = ";SC/SQR(SX*SY)
  34. 240  ADF=N-2: ST=SQR(SR2*ADF/(1-SR2)): PRINT: PRINT
  35. 250  PRINT "    Significance of correlation:     T = ";ST;SPC(7);"df = ";ADF
  36. 260  R=ATN(ST/SQR(ADF)): RC=COS(R): R2=RC*RC: RS=SIN(R): X=1
  37. 270  IF ADF MOD 2=0 THEN 320
  38. 280  IF ADF=1 THEN Y=R: GOTO 310
  39. 290  Y=RC: FOR Z=3 TO (ADF-2) STEP 2: X=X*R2*(Z-1)/Z: Y=Y+X*RC: NEXT
  40. 300  Y=R+RS*Y
  41. 310  P=1-Y*0.63662: GOTO 350
  42. 320  Y=1: FOR Z=2 TO (ADF-2) STEP 2: X=X*R2*(Z-1)/Z: Y=Y+X: NEXT
  43. 330  P=1-Y*RS
  44. 350  FOR Z=11 TO 41 STEP 3: PLAY "MB L32 N=Z;":NEXT Z: PLAY "MB L6 N44 P12 L16 N17 L4 N18 L3 N11"
  45. 355  PRINT:PRINT TAB(28);"p = ";:IF P<9.99E-07 THEN PRINT "< 10 (-6)" ELSE PRINT P
  46. 360  PRINT : COLOR 0,7: PRINT TAB(6);"This correlation coefficient is ";
  47. 370  IF P>0.05 THEN PRINT "NOT ";
  48. 380  PRINT "significantly different than 0       ": COLOR 7,0: PRINT
  49. 390  PRINT: PRINT: PRINT "  Would you like to ";
  50. 400  IF AF=1 THEN PRINT "evaluate another correlation coefficient? (Y or N)  ";  ELSE PRINT "calculate another R value using this DATAFILE? (Y or N)  ";
  51. 410  INPUT "",A$: IF A$="y" OR A$="Y" THEN CLS: IF AF=1 THEN 70 ELSE 150
  52. 420  END
  53. 430  BEEP: PRINT: IF ERL=90 AND ERR=53 THEN PRINT: PRINT TAB(13); "I cannot find a file by that name on drive "; ELSE 460
  54. 440  IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE DR$="A:"
  55. 450  PRINT DR$: PRINT "Your files are:": FILES DR$+"*.*": RESUME 30
  56. 460  ON ERROR GOTO 0
  57.